Also see core-practices-over-time.html.

dat <- import(here("data/longitudinal", "full-tags-wide.csv"))
dictionary <- import(here("data/2024 data", "dictionary_2024.csv"))
clean_labels <- import(here("data/longitudinal", "tag-labels.csv"))
source(here("scripts/branding.R"))

Which core practices have been implemented most over time?

core_prac <- dat %>% 
  select(school_id, year, starts_with("core")) %>% 
  mutate(school_id = as.factor(school_id),
         year = as.factor(year)) 

core_prac[is.na(core_prac)] <- 0

core_prac <- core_prac %>% 
#  summarise(across(where(is.numeric), ~ sum(.x, na.rm = TRUE))) %>% 
  pivot_longer(starts_with("core"),
               names_to = "core_practice",
               values_to = "times_selected") 

core_prac_dat <- core_prac %>% 
  group_by(core_practice) %>% 
  summarise(selected = sum(times_selected)) %>% 
              arrange(-selected)

First note: there are 26 practices that have never been selected as a core practice. They are the following:

no_core <- core_prac_dat %>% 
  filter(selected == 0) %>% 
  mutate(core_practice = sub("core_", "", core_practice)) %>% 
  pull(core_practice)

no_core
##  [1] "alternating_days"         "assessment_schedule"     
##  [3] "data_instruction"         "design_margins"          
##  [5] "devices_home"             "ell_supports"            
##  [7] "equity_plan"              "experiential"            
##  [9] "flexible_schedule"        "graduation_supports"     
## [11] "half_days"                "hiring_practices"        
## [13] "immigrants_supports"      "information_formats"     
## [15] "lab_rotation"             "learner_agency"          
## [17] "local_global"             "maker"                   
## [19] "measures_climate"         "measures_college"        
## [21] "measures_purpose"         "oer"                     
## [23] "other_leaders"            "poverty_supports"        
## [25] "print_materials"          "quality_materials"       
## [27] "relevant_learning"        "rigorous_coursework"     
## [29] "sel_plan"                 "staffing_infrastructure" 
## [31] "teachers_choose_modality" "wraparound"

These are the rest.

datatable(core_prac_dat)

Let’s look more closely at the top 10 on this list.

top_core <- core_prac_dat %>% 
  head(10) %>% 
  pull(core_practice)

top_core_dat <- core_prac %>% 
  filter(core_practice %in% top_core) %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected))
top_core_dat %>% 
  filter(year != 2019) %>% 
  ggplot(aes(reorder(core_practice, selected), selected, fill = year)) +
  geom_col() +
  scale_fill_manual(values = transcend_cols) +
  scale_y_continuous(expand = c(0,0)) +
  labs(title = "Core Practices by Year Implemented",
       x = "",
       y = "") +
#  scale_x_discrete(labels = label_tags()) +
  theme(legend.position = "bottom", 
        legend.direction = "horizontal",
        text = element_text(size = 7),
        axis.text.x = element_text(angle = 45, hjust = 1)) + 
  coord_flip() +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom"
  ) 

It looks like 2021 was really driving the top core practices list across the years. Is that true?

Update – look more closely at tag sample

full_tags_long <- import(here("data/longitudinal/full-tags-long.csv"))
tags_2019 <- full_tags_long %>% 
  filter(year == 2019) %>% 
  group_by(var) %>% 
  summarise(`2019` = sum(usage), .groups = "drop") #173 schools

tags_2021 <- full_tags_long %>% 
  filter(year == 2021) %>% 
  group_by(var) %>% 
  summarise(`2021` = sum(usage), .groups = "drop")  #232 schools

tags_2022 <- full_tags_long %>% 
  filter(year == 2022) %>% 
  group_by(var) %>% 
  summarise(`2022` = sum(usage), .groups = "drop") #161 schools

tags_2023 <- full_tags_long %>% 
  filter(year == 2023) %>% 
  group_by(var) %>% 
  summarise(`2023` = sum(usage), .groups = "drop") #251 schools

tags_2024 <- full_tags_long %>% 
  filter(year == 2024) %>% 
  group_by(var) %>% 
  summarise(`2024` = sum(usage), .groups = "drop") #189 schools
# Create a dataframe with variables and their years
tags_list <- list(
  `2019` = tags_2019 %>% pull(var) %>% unique(),
  `2021` = tags_2021 %>% pull(var) %>% unique(),
  `2022` = tags_2022 %>% pull(var) %>% unique(),
  `2023` = tags_2023 %>% pull(var) %>% unique(),
  `2024` = tags_2024 %>% pull(var) %>% unique()
)

# Combine the list into a long dataframe
tags_df <- bind_rows(
  lapply(names(tags_list), function(year) {
    data.frame(variable = tags_list[[year]], year = as.integer(year))
  })
)

# Summarize the number of years each variable is used and list the years used
variable_usage <- tags_df %>%
  group_by(variable) %>%
  summarise(
    number_of_years_used = n_distinct(year),
    years_used = paste(sort(unique(year)), collapse = ", ")
  )

Now, let’s look more closely at the tags that have never been selected as core.

variable_usage %>% 
  mutate(variable = sub("practices_", "", variable)) %>%  
  filter(variable %in% no_core) %>% 
  datatable()

Looks like all are from 2019 except other_leaders, which is from 2023.

Here is the rest of them.

variable_usage %>% 
  mutate(variable = sub("practices_", "", variable)) %>%  
  filter(!variable %in% no_core) %>% 
  datatable()

Update for Aug 2

I want to look at the top 10 core practices by year implemented stacked bar chart by also looking at the years the tag was offered.

top_core_dat <- top_core_dat %>% 
  mutate(core_practice = gsub("core_", "", core_practice))


top_by_use <- variable_usage %>% 
  mutate(variable = gsub("practices_", "", variable)) %>% 
  right_join(., top_core_dat, by = c("variable" = "core_practice")) 

total_select <- top_by_use %>% 
  group_by(variable) %>% 
  summarise(total_select = sum(selected)) %>% 
  ungroup()

top_by_use <- left_join(top_by_use, total_select)
tag_labels <- import(here("data/longitudinal", "tag-labels.csv"))

top_by_use %>% 
  filter(year != 2019) %>% 
  left_join(., tag_labels) %>% 
  ggplot() +
  geom_text(aes(label = years_used, x = label, y = total_select + 2), hjust = 0, size = 5, color = "gray") +
  geom_col(aes(reorder(label, selected), selected, fill = year)) +
  scale_fill_manual(values = transcend_cols) +
  scale_y_continuous(expand = c(0,0), limits = c(0, 342)) +
  labs(title = "Core Practices by Year Implemented",
       x = "",
       y = "") +
#  scale_x_discrete(labels = label_tags()) +
  theme(legend.position = "bottom", 
        legend.direction = "horizontal",
        text = element_text(size = 20),
        axis.text.x = element_text(angle = 45, hjust = 1)) + 
  coord_flip() +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom"
  ) 

top_by_use %>% 
  left_join(., tag_labels) %>% 
  select(label, number_of_years_used, years_used, year, selected, total_select) %>% 
  datatable()

Also update core practices by number of years that tags were implemented

# times practices are selected each year needed for sorting
core_prac_dat <- core_prac_dat %>% 
  mutate(core_practice = gsub("core_", "practices_", core_practice)) %>% 
  rename(times_selected = selected)

core_prac %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  mutate(core_practice = gsub("core_", "practices_", core_practice)) %>% 
  left_join(., variable_usage, by = c("core_practice" = "variable")) %>% 
  filter(year != 2019) %>% 
  left_join(., core_prac_dat) %>% 
  select(-years_used) %>% 
  arrange(-times_selected) %>% 
  group_by(core_practice) %>% 
  left_join(., clean_labels, by = c("core_practice" = "variable")) %>% 
  filter(number_of_years_used > 4) %>% 
  filter(times_selected > 104) %>% 
  ggplot() +
    geom_col(aes(reorder(label, times_selected), selected, fill = year)) +
    scale_fill_manual(values = transcend_cols) +
    scale_y_continuous(expand = c(0,0)) +
  labs(title = "Most selected core practices (4+ years)",
       x = "",
       y = "") +
#  scale_x_discrete(labels = label_tags()) +
  theme(legend.position = "bottom", 
        legend.direction = "horizontal",
  #      text = element_text(size = 20),
        axis.text.x = element_text(angle = 45, hjust = 1)) + 
  coord_flip() +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom"
  ) 

core_prac %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  mutate(core_practice = gsub("core_", "practices_", core_practice)) %>% 
  left_join(., variable_usage, by = c("core_practice" = "variable")) %>% 
  filter(year != 2019) %>% 
  left_join(., core_prac_dat) %>% 
  select(-years_used) %>% 
  arrange(-times_selected) %>% 
  group_by(core_practice) %>% 
  left_join(., clean_labels, by = c("core_practice" = "variable")) %>% 
  filter(number_of_years_used > 4) %>% 
  filter(times_selected > 104) %>% 
  mutate(label = ifelse(label == "competency/mastery-based education", "competency/ mastery-based education", label)) %>% 
  ggplot() +
    geom_col(aes(reorder(label, times_selected), selected, fill = year), position = "dodge") +
    scale_fill_manual(values = transcend_cols) +
    scale_y_continuous(expand = c(0,0)) +
  scale_x_discrete(labels = scales::label_wrap(10), guide = guide_axis(n.dodge = 1)) +
  labs(title = "Most selected core practices (4+ years)",
       x = "",
       y = "") +
#  scale_x_discrete(labels = label_tags()) +
  theme(legend.position = "bottom", 
        legend.direction = "horizontal",
        text = element_text(size = 9),
        axis.text.x = element_text()) + 
  theme(
    panel.grid.major.x = element_blank(),
    legend.position = "bottom"
  ) 

Update for 8/9

n_2019 <- 173
n_2021 <- 232
n_2022 <- 161
n_2023 <- 251
n_2024 <- 189

core_prac_plot_dat <- core_prac %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  mutate(core_practice = gsub("core_", "practices_", core_practice)) %>% 
  left_join(., variable_usage, by = c("core_practice" = "variable")) %>% 
  filter(year != 2019) %>% 
  left_join(., core_prac_dat) %>% 
  select(-years_used) %>% 
  arrange(-times_selected) %>% 
  group_by(core_practice) %>% 
  left_join(., clean_labels, by = c("core_practice" = "variable")) %>% 
  filter(number_of_years_used > 4) %>% 
  mutate(pct = case_when(year == 2021 ~ selected/n_2021,
                         year == 2022 ~ selected/n_2022,
                         year == 2023 ~ selected/n_2023,
                         year == 2024 ~ selected/n_2024)) %>% 
  group_by(year) %>% 
  arrange(year, desc(pct)) %>% 
  slice_max(pct, n = 10) %>% 
  ungroup()

core_prac_plot_dat %>% 
  mutate(label = reorder_within(label, pct, year)) %>% 
  ggplot(aes(label, pct, fill = year)) +
    geom_col() +
    scale_fill_manual(values = transcend_cols) +
    scale_y_continuous(expand = c(0,0), labels = scales::percent_format()) +
  facet_wrap(~year, scales = "free_y") + #, axes = "all"
  labs(title = "Most selected core practices (4+ years)",
       x = "",
       y = "") +
  theme(legend.position = "none", 
        legend.direction = "horizontal",
        text = element_text(size = 8),
        panel.grid.major.y = element_blank(),
        axis.text.x = element_text(angle = 45, hjust = 1),
        strip.placement = "outside") + 
  coord_flip() +
  tidytext::scale_x_reordered()

core_prac_plot_dat %>% 
  mutate(label = reorder_within(label, pct, year)) %>% 
  ggplot(aes(label, pct, fill = year)) +
    geom_col() +
    scale_fill_manual(values = transcend_cols) +
    scale_y_continuous(expand = c(0,0), labels = scales::percent_format()) +
  labs(title = "Most selected core practices (4+ years)",
       x = "",
       y = "") +
  theme(legend.position = "none", 
        legend.direction = "horizontal",
        text = element_text(size = 8),
        panel.grid.major.y = element_blank(),
        axis.text.x = element_text(angle = 45, hjust = 1),
        strip.placement = "outside") + 
  scale_x_discrete(labels = scales::label_wrap(10), guide = guide_axis(n.dodge = 1)) +
  tidytext::scale_x_reordered()

core_prac %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  mutate(core_practice = gsub("core_", "practices_", core_practice)) %>% 
  left_join(., variable_usage, by = c("core_practice" = "variable")) %>% 
  filter(year != 2019) %>% 
  left_join(., core_prac_dat) %>% 
  select(-years_used) %>% 
  arrange(-times_selected) %>% 
  group_by(core_practice) %>% 
  left_join(., clean_labels, by = c("core_practice" = "variable")) %>% 
  filter(number_of_years_used > 4) %>% 
  filter(times_selected > 104) %>% 
  mutate(label = ifelse(label == "competency/mastery-based education", "competency/ mastery-based education", label)) %>% 
  mutate(pct = case_when(year == 2021 ~ selected/n_2021,
                         year == 2022 ~ selected/n_2022,
                         year == 2023 ~ selected/n_2023,
                         year == 2024 ~ selected/n_2024)) %>% 
  ggplot() +
    geom_col(aes(reorder(label, times_selected), pct, fill = year), position = "dodge") +
    scale_fill_manual(values = transcend_cols) +
    scale_y_continuous(expand = c(0,0), limits = c(0, .8), labels = scales::percent) +
  scale_x_discrete(labels = scales::label_wrap(10), guide = guide_axis(n.dodge = 1)) +
  labs(title = "Most selected core practices",
       subtitle = "These core practices have been around for at least 4 years.",
       x = "",
       y = "") +
#  scale_x_discrete(labels = label_tags()) +
  theme(legend.position = "bottom", 
        legend.direction = "horizontal",
        text = element_text(size = 9),
        axis.text.x = element_text()) + 
  theme(
    panel.grid.major.x = element_blank(),
    legend.position = "bottom"
  ) 

core_prac %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  mutate(core_practice = gsub("core_", "practices_", core_practice)) %>% 
  left_join(., variable_usage, by = c("core_practice" = "variable")) %>% 
  filter(year != 2019) %>% 
  left_join(., core_prac_dat) %>% 
  select(-years_used) %>% 
  arrange(-times_selected) %>% 
  group_by(core_practice) %>% 
  left_join(., clean_labels, by = c("core_practice" = "variable")) %>% 
  filter(number_of_years_used > 4) %>% 
  filter(times_selected > 139) %>% 
  mutate(label = ifelse(label == "competency/mastery-based education", "competency/ mastery-based education", label)) %>% 
  mutate(pct = case_when(year == 2021 ~ selected/n_2021,
                         year == 2022 ~ selected/n_2022,
                         year == 2023 ~ selected/n_2023,
                         year == 2024 ~ selected/n_2024)) %>% 
  ggplot() +
    geom_col(aes(reorder(label, times_selected), pct, fill = year), position = "dodge") +
    scale_fill_manual(values = transcend_cols) +
    scale_y_continuous(expand = c(0,0), limits = c(0, .8), labels = scales::percent) +
  scale_x_discrete(labels = scales::label_wrap(10), guide = guide_axis(n.dodge = 1)) +
  labs(title = "Most selected core practices",
       subtitle = "These core practices have been around for at least 4 years.",
       x = "",
       y = "") +
#  scale_x_discrete(labels = label_tags()) +
  theme(legend.position = "bottom", 
        legend.direction = "horizontal",
        text = element_text(size = 9),
        axis.text.x = element_text()) + 
  theme(
    panel.grid.major.x = element_blank(),
    legend.position = "bottom"
  ) 

And without 2021 year

core_prac_plot_dat %>% 
  filter(year != 2021) %>% 
  mutate(label = reorder_within(label, pct, year)) %>% 
  ggplot(aes(label, pct, fill = year)) +
    geom_col() +
    scale_fill_manual(values = transcend_cols) +
    scale_y_continuous(expand = c(0,0), labels = scales::percent_format()) +
  facet_wrap(~year, scales = "free_y") + #, axes = "all"
  labs(title = "Most selected core practices (4+ years)",
       x = "",
       y = "") +
  theme(legend.position = "none", 
        legend.direction = "horizontal",
        text = element_text(size = 7),
        panel.grid.major.y = element_blank(),
        axis.text.x = element_text(angle = 45, hjust = 1),
        strip.placement = "outside") + 
  coord_flip() +
  tidytext::scale_x_reordered()

Have any lost popularity over the last 5 years?

Well, this is an interesting question given that 2021 seems like it was the year that schools were more liberal with their core practice selections, so I imagine this affects most practices. But let’s look at them below.

p <- core_prac %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  filter(year != 2019) %>% 
  mutate(year = as.numeric(year)) %>% 
  ggplot(aes(year, selected, color = core_practice)) +
  geom_point() +
  geom_line() +
  scale_fill_manual(values = transcend_cols2) +
  scale_y_continuous(expand = c(0,0)) +
  labs(title = "Core Practices by Year Implemented",
       x = "",
       y = "") +
#  scale_x_discrete(labels = label_tags()) +
  theme(legend.position = "none", 
        legend.direction = "horizontal",
        text = element_text(size = 7),
        axis.text.x = element_text(angle = 45, hjust = 1)) + 
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "none"
  ) 

ggplotly(p, tooltip = c("core_practice", "selected"))

Update – tag count breakdown by year

variable_usage_by_year <- tags_2019 %>%
  full_join(tags_2021, by = "var") %>%
  full_join(tags_2022, by = "var") %>%
  full_join(tags_2023, by = "var") %>%
  full_join(tags_2024, by = "var") %>% 
  left_join(clean_labels, by = c("var" = "variable"))
variable_usage_by_year %>% 
  select(label, everything(), -var) %>% 
  mutate(total = rowSums(select(.,`2019`:`2024`), na.rm = TRUE)) %>% 
  datatable()

Filter to tags that have been used at least 4 years.

vars_4plus <- variable_usage %>% filter(number_of_years_used >= 4) %>% pull(variable)

variable_usage_by_year %>% 
  filter(var %in% vars_4plus) %>% 
  select(label, everything(), -var) %>% 
  mutate(total = rowSums(select(.,`2019`:`2024`), na.rm = TRUE)) %>% 
  datatable()

Which are the oldest stable core tags and newest growing tags?

stable_prac <- core_prac %>%
    group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  filter(year != 2019) %>% 
  group_by(core_practice) %>%
  summarise(
    min_selected = min(selected, na.rm = TRUE),
    max_selected = max(selected, na.rm = TRUE),
    range_selected = max_selected - min_selected
  ) %>%
  filter(range_selected <= 50) %>%
  pull(core_practice) 

p <- core_prac %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  filter(year != 2019) %>% 
  filter(core_practice %in% stable_prac) %>% 
  filter(selected > 20) %>% 
  mutate(year = as.numeric(year)) %>% 
  ggplot(aes(year, selected, color = core_practice)) +
  geom_point() +
  geom_line() +
  scale_fill_manual(values = transcend_cols2) +
  scale_y_continuous(expand = c(0,0)) +
  labs(title = "Stable Tags (Selected >20, varied <50)",
       x = "",
       y = "") +
#  scale_x_discrete(labels = label_tags()) +
  theme(legend.position = "none", 
        legend.direction = "horizontal",
        text = element_text(size = 7),
        axis.text.x = element_text(angle = 45, hjust = 1)) + 
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "none"
  ) 

ggplotly(p, tooltip = c("core_practice", "selected"))

For newest growing tags, in my first pass, I am going to filter the practices to those that increased between 2022 and 2024. I’m omitting 2021 for the filter.

increased_prac <- core_prac %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  filter(year %in% c(2022, 2024)) %>% 
  pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
  mutate(change = year_2024 - year_2022) %>%
  filter(change > 0) %>% 
  arrange(desc(change)) %>% 
  pull(core_practice)

p <- core_prac %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  filter(year != 2019) %>% 
  filter(core_practice %in% increased_prac) %>% 
  mutate(year = as.numeric(year)) %>% 
  ggplot(aes(year, selected, color = core_practice)) +
  geom_point() +
  geom_line() +
  scale_fill_manual(values = transcend_cols2) +
  scale_y_continuous(expand = c(0,0)) +
  labs(title = "Tags Increasing since 2022",
       x = "",
       y = "") +
#  scale_x_discrete(labels = label_tags()) +
  theme(legend.position = "none", 
        legend.direction = "horizontal",
        text = element_text(size = 7),
        axis.text.x = element_text(angle = 45, hjust = 1)) + 
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "none"
  ) 

ggplotly(p, tooltip = c("core_practice", "selected"))
core_prac %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  filter(year != 2019) %>% 
  filter(year != 2021) %>% 
  filter(core_practice %in% increased_prac) %>% 
  ggplot(aes(reorder(core_practice, selected), selected, fill = year)) +
  geom_col() +
  scale_fill_manual(values = transcend_cols) +
  scale_y_continuous(expand = c(0,0)) +
  labs(title = "Practices Increasing in Selection Since 2022",
       x = "",
       y = "") +
#  scale_x_discrete(labels = label_tags()) +
  theme(legend.position = "bottom", 
        legend.direction = "horizontal",
        text = element_text(size = 7),
        axis.text.x = element_text(angle = 45, hjust = 1)) + 
  coord_flip() +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom"
  )

What about those with the largest change?

core_prac %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  filter(year %in% c(2022, 2024)) %>% 
  pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
  mutate(change = year_2024 - year_2022) %>%
  filter(change > 0) %>% 
  arrange(desc(change)) %>% 
  head(10) %>% 
  ggplot(aes(x = year_2022, xend = year_2024, y = reorder(core_practice, change), yend = core_practice)) +
  geom_segment(color = "black", linetype = "dotted") +
  geom_point(aes(x = year_2022), color = "red") +
  geom_point(aes(x = year_2024), color = "blue") +
  guides(col = guide_legend(nrow = 1, title = NULL)) + 
  geom_text(
    aes(x = (year_2022 + year_2024)/2 -1, label = paste("Δ =", year_2024 - year_2022), color = factor(sign(year_2024 - year_2022))),
    nudge_y = .3,
    hjust = 0,
    show.legend = FALSE
  )  +
  labs(
    y = "Core Practice",
    x = "Times Selected",
    title = "Core Practices with largest increase \nfrom 2022 to 2024 Across Schools"
  ) +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom",
    axis.text.y = element_text(size = rel(0.6))
  )

Update for Aug 2

n_2019 <- 173
n_2021 <- 232
n_2022 <- 161
n_2023 <- 251
n_2024 <- 189

var_prop_use <- variable_usage_by_year %>% 
  select(label, everything(), -var) %>% 
  mutate(prop_2019 = `2019`/n_2019,
         prop_2021 = `2021`/n_2021,
         prop_2022 = `2022`/n_2022,
         prop_2023 = `2023`/n_2023,
         prop_2024 = `2024`/n_2024)

stable_var_prop <- var_prop_use %>% 
  select(label, starts_with("prop")) %>% 
  pivot_longer(cols = starts_with("prop"),
               names_to = "year",
               values_to = "prop",
               names_prefix = "prop_") %>% 
  group_by(label) %>% 
  summarise(
    min_prop = min(prop, na.rm = TRUE),
    max_prop = max(prop, na.rm = TRUE),
    range_prop = max_prop - min_prop
  ) %>% 
  filter(range_prop < .1) %>% 
  filter(range_prop > 0) %>% 
  pull(label)
  
p <- var_prop_use %>% 
  select(label, starts_with("prop")) %>% 
  pivot_longer(cols = starts_with("prop"),
               names_to = "year",
               values_to = "prop",
               names_prefix = "prop_") %>% 
  group_by(label, year) %>% 
  filter(label %in% stable_var_prop) %>% 
  mutate(year = as.numeric(year)) %>% 
  ggplot(aes(year, prop, color = label)) +
  geom_point() +
  geom_line() +
  scale_fill_manual(values = transcend_cols2) +
  scale_y_continuous(expand = c(0,0)) +
  labs(title = "Stable Tags (varied < 10%)",
       x = "",
       y = "") +
  theme(legend.position = "none", 
        legend.direction = "horizontal",
        text = element_text(size = 7),
        axis.text.x = element_text(angle = 45, hjust = 1)) + 
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "none"
  ) 

ggplotly(p, tooltip = c("label", "prop"))

Now let’s look at tags that have been growing for the last 2 years.

p <- var_prop_use %>% 
  select(label, starts_with("prop")) %>% 
  mutate(growth = prop_2024 - prop_2022) %>% 
  filter(growth > 0) %>% 
  select(-growth) %>% 
  pivot_longer(cols = starts_with("prop"),
               names_to = "year",
               values_to = "prop",
               names_prefix = "prop_") %>% 
  filter(year != 2019) %>% 
  filter(year != 2021) %>% 
  mutate(year = as.integer(year)) %>% 
  ggplot(aes(year, prop, color = label)) +
  geom_point() +
  geom_line() +
  scale_fill_manual(values = transcend_cols2) +
  scale_y_continuous(expand = c(0,0)) +
  labs(title = "Tags Growing since 2022",
       x = "",
       y = "") +
  theme(legend.position = "none", 
        legend.direction = "horizontal",
        text = element_text(size = 7),
        axis.text.x = element_text(angle = 45, hjust = 1)) + 
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "none"
  ) 

ggplotly(p, tooltip = c("label", "prop"))

Look more closely at additions: within schools, these are the tags that have been most frequently added in the last two years.

growing_tags <- var_prop_use %>% 
  select(label, starts_with("prop")) %>% 
  mutate(growth = prop_2024 - prop_2022) %>% 
  filter(growth > 0) %>% 
  select(-growth) %>% 
  pivot_longer(cols = starts_with("prop"),
               names_to = "year",
               values_to = "prop",
               names_prefix = "prop_") %>% 
  filter(year != 2019) %>% 
  filter(year != 2021) %>% 
  group_by(label) %>% 
  summarize(n = n()) %>% 
  pull(label)
  


full_tags_long %>% 
  select(-core, -time) %>% 
  filter(year != 2021) %>% 
  filter(year != 2019) %>% 
  pivot_wider(names_from = "year",
              values_from = "usage") %>% 
  left_join(clean_labels, by = c("var" = "variable")) %>% 
  select(-var) %>% 
  filter(label %in% growing_tags) %>% 
  mutate(added = `2024` - `2022`) %>% 
  filter(added >0) %>% 
  group_by(label) %>% 
  summarise(schools_added = sum(added)) %>% 
  arrange(-schools_added) %>% 
  head(10) %>% 
  ggplot(aes(reorder(label, schools_added), schools_added)) +
  geom_col(fill = transcend_cols[2]) +
  scale_y_continuous(expand = c(0,0)) +
  labs(title = "Tags Added by Schools in the Last Two Years",
       x = "",
       y = "") +
  theme(legend.position = "none", 
        legend.direction = "horizontal",
        text = element_text(size = 9),
        axis.text.x = element_text(angle = 45, hjust = 1)) + 
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "none"
  ) +
  coord_flip()

Largest change graph redone with percentages:

Increase –

core_prac %>% 
  mutate(core_practice = gsub("core_", "practices_", core_practice)) %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  filter(year %in% c(2022, 2024)) %>% 
  pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
  mutate(prop_2022 = (year_2022/n_2022)*100,
         prop_2024 = (year_2024/n_2024)*100,
         change = prop_2024 - prop_2022) %>%
  filter(change > 0) %>% 
  arrange(desc(change)) %>% 
  head(10) %>% 
  left_join(., clean_labels, by = c("core_practice" = "variable")) %>% 
  ggplot(aes(x = prop_2022, xend = prop_2024, y = reorder(label, change), yend = label)) +
  geom_segment(color = "black", linetype = "dotted") +
  geom_point(aes(x = prop_2022), color = "red") +
  geom_point(aes(x = prop_2024), color = "blue") +
  guides(col = guide_legend(nrow = 1, title = NULL)) + 
  geom_text(
    aes(x = (prop_2022 + prop_2024)/2 -1, label = paste0("Δ = ", round(prop_2024 - prop_2022), "%"), color = factor(sign(prop_2024 - prop_2022))),
    nudge_y = .3,
    hjust = 0,
    show.legend = FALSE
  )  +
  labs(
    y = "Core Practice",
    x = "%Times Selected",
    title = "Core Practices with largest increase \nfrom 2022 to 2024 Across Schools"
  ) +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom",
    axis.text.y = element_text(size = rel(0.6))
  )

Decrease –

core_prac %>% 
  mutate(core_practice = gsub("core_", "practices_", core_practice)) %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  filter(year %in% c(2022, 2024)) %>% 
  pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
  mutate(prop_2022 = (year_2022/n_2022)*100,
         prop_2024 = (year_2024/n_2024)*100,
         change = prop_2024 - prop_2022) %>%
  filter(year_2024 > 0) %>% 
  filter(change < 0) %>% 
  arrange(change) %>% 
  head(10) %>% 
  left_join(., clean_labels, by = c("core_practice" = "variable")) %>% 
  ggplot(aes(x = prop_2022, xend = prop_2024, y = reorder(label, -change), yend = label)) +
  geom_segment(color = "black", linetype = "dotted") +
  geom_point(aes(x = prop_2022), color = "red") +
  geom_point(aes(x = prop_2024), color = "blue") +
  guides(col = guide_legend(nrow = 1, title = NULL)) + 
  geom_text(
    aes(x = (prop_2022 + prop_2024)/2 -1, label = paste0("Δ = ", round(prop_2024 - prop_2022), "%"), color = factor(sign(prop_2024 - prop_2022))),
    nudge_y = .3,
    hjust = 0,
    show.legend = FALSE
  )  +
  labs(
    y = "Core Practice",
    x = "%Times Selected",
    title = "Core Practices with largest decrease \nfrom 2022 to 2024 Across Schools"
  ) +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom",
    axis.text.y = element_text(size = rel(0.6))
  )

Restrict to tags available for all of these years.

used_22_24 <- variable_usage_by_year %>% 
  select(label, `2022`, `2023`, `2024`) %>% 
  remove_missing() %>% 
  pull(label)

core_prac %>% 
  mutate(core_practice = gsub("core_", "practices_", core_practice)) %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  filter(year %in% c(2022, 2024)) %>% 
  pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
  mutate(prop_2022 = (year_2022/n_2022)*100,
         prop_2024 = (year_2024/n_2024)*100,
         change = prop_2024 - prop_2022) %>%
  filter(year_2024 > 0) %>% 
  filter(change < 0) %>% 
  arrange(change) %>% 
  left_join(., clean_labels, by = c("core_practice" = "variable")) %>% 
  filter(label %in% used_22_24) %>% 
  head(10) %>% 
  ggplot(aes(x = prop_2022, xend = prop_2024, y = reorder(label, -change), yend = label)) +
  geom_segment(color = "black", linetype = "dotted") +
  geom_point(aes(x = prop_2022), color = "red") +
  geom_point(aes(x = prop_2024), color = "blue") +
  guides(col = guide_legend(nrow = 1, title = NULL)) + 
  geom_text(
    aes(x = (prop_2022 + prop_2024)/2 -1, label = paste0("Δ = ", round(prop_2024 - prop_2022), "%"), color = factor(sign(prop_2024 - prop_2022))),
    nudge_y = .3,
    hjust = 0,
    show.legend = FALSE
  )  +
  labs(
    y = "Core Practice",
    x = "%Times Selected",
    title = "Core Practices with largest decrease \nfrom 2022 to 2024 Across Schools",
    subtitle = "Tags were available for selection all years."
  ) +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom",
    axis.text.y = element_text(size = rel(0.6))
  )

core_prac %>% 
  mutate(core_practice = gsub("core_", "practices_", core_practice)) %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  filter(year %in% c(2022, 2024)) %>% 
  pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
  mutate(prop_2022 = (year_2022/n_2022)*100,
         prop_2024 = (year_2024/n_2024)*100,
         change = prop_2024 - prop_2022) %>%
  filter(change > 0) %>% 
  arrange(desc(change)) %>% 
  left_join(., clean_labels, by = c("core_practice" = "variable")) %>% 
  filter(label %in% used_22_24) %>% 
  head(10) %>% 
  ggplot(aes(x = prop_2022, xend = prop_2024, y = reorder(label, change), yend = label)) +
  geom_segment(color = "black", linetype = "dotted") +
  geom_point(aes(x = prop_2022), color = "red") +
  geom_point(aes(x = prop_2024), color = "blue") +
  guides(col = guide_legend(nrow = 1, title = NULL)) + 
  geom_text(
    aes(x = (prop_2022 + prop_2024)/2 -1, label = paste0("Δ = ", round(prop_2024 - prop_2022), "%"), color = factor(sign(prop_2024 - prop_2022))),
    nudge_y = .3,
    hjust = 0,
    show.legend = FALSE
  )  +
  labs(
    y = "Core Practice",
    x = "%Times Selected",
    title = "Core Practices with largest increase \nfrom 2022 to 2024 Across Schools",
    subtitle = "Tags were available for selection all years."
  ) +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom",
    axis.text.y = element_text(size = rel(0.6))
  )

### Update for 8/9

increase_plot <- core_prac %>% 
  mutate(core_practice = gsub("core_", "practices_", core_practice)) %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  filter(year %in% c(2022, 2024)) %>% 
  pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
  mutate(prop_2022 = (year_2022/n_2022)*100,
         prop_2024 = (year_2024/n_2024)*100,
         change = prop_2024 - prop_2022) %>%
  filter(change > 0) %>% 
  arrange(desc(change)) %>% 
  left_join(., clean_labels, by = c("core_practice" = "variable")) %>% 
  filter(label %in% used_22_24) %>% 
  head(5) %>% 
  ggplot(aes(x = prop_2022, xend = prop_2024, y = reorder(label, change), yend = label)) +
  geom_segment(color = "black", linetype = "dotted") +
  geom_point(aes(x = prop_2022), color = "red") +
  geom_point(aes(x = prop_2024), color = "blue") +
  guides(col = guide_legend(nrow = 1, title = NULL)) + 
  geom_text(
    aes(x = (prop_2022 + prop_2024)/2 -1, label = paste0("Δ = ", round(prop_2024 - prop_2022), "%"), color = factor(sign(prop_2024 - prop_2022))),
    nudge_y = .3,
    hjust = 0,
    show.legend = FALSE
  )  +
  labs(
    y = "Increase",
    x = ""
  ) +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom",
    axis.text.y = element_text(size = rel(0.6)),
    axis.text.x = element_blank()
  ) +
  scale_x_continuous(labels = scales::percent_format(scale = 1), limits = c(0, 28)) +
  scale_y_discrete(labels = scales::label_wrap(30))

decrease_plot <- core_prac %>% 
  mutate(core_practice = gsub("core_", "practices_", core_practice)) %>% 
  group_by(core_practice, year) %>% 
  summarise(selected = sum(times_selected)) %>% 
  filter(year %in% c(2022, 2024)) %>% 
  pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
  mutate(prop_2022 = (year_2022/n_2022)*100,
         prop_2024 = (year_2024/n_2024)*100,
         change = prop_2024 - prop_2022) %>%
  filter(year_2024 > 0) %>% 
  filter(change < 0) %>% 
  arrange(change) %>% 
  left_join(., clean_labels, by = c("core_practice" = "variable")) %>% 
  filter(label %in% used_22_24) %>% 
  head(5) %>% 
  ggplot(aes(x = prop_2022, xend = prop_2024, y = reorder(label, -change), yend = label)) +
  geom_segment(color = "black", linetype = "dotted") +
  geom_point(aes(x = prop_2022), color = "red") +
  geom_point(aes(x = prop_2024), color = "blue") +
  guides(col = guide_legend(nrow = 1, title = NULL)) + 
  geom_text(
    aes(x = (prop_2022 + prop_2024)/2 -1, label = paste0("Δ = ", round(prop_2024 - prop_2022), "%"), color = factor(sign(prop_2024 - prop_2022))),
    nudge_y = .3,
    hjust = 0,
    show.legend = FALSE
  )  +
  labs(
    y = "Decrease",
    x = "Percentage of Canopy Schools"
  ) +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom",
    axis.text.y = element_text(size = rel(0.6))
  ) +
  scale_x_continuous(labels = scales::percent_format(scale = 1),  limits = c(0, 28)) +
  scale_y_discrete(labels = scales::label_wrap(30))

increase_plot

decrease_plot

library(patchwork)
increase_plot + decrease_plot + plot_layout(ncol = 1) + plot_annotation(title = "Core Practices with Largest Increase/Decrease",
                                                                        subtitle = "These tags increased or decreased between 2022 and 2024 across schools.",
                  theme = theme(plot.title = element_text(hjust = 0.5),
                                plot.subtitle = element_text(hjust = 0.5)))

What is the relationship between core practices most implemented over time and practices on the horizon?

Are we seeing a lot of “brand new” practices piloted, are schools more or less trying out “established” practices, or both?

load(here("data/2024 data", "complete_canopy_2024.RData"))

old_clusters <- import(here("data/clusters_through_2024.csv"))
pilot_prac <- tags %>% 
  select(starts_with("pilot")) %>% 
  pivot_longer(everything(),
               names_to = "practice",
               values_to = "N",
               names_prefix = "pilot_") %>% 
  group_by(practice) %>% 
  summarise(selected = sum(N))

These are the practices by time implemented:

implementation_time <- tags %>% 
  select(starts_with("time_")) %>% 
  pivot_longer(everything(),
               names_to = "practice",
               values_to = "N") %>% 
  mutate(`Not sure` = case_when(N == "Not sure" ~ 1, 
                                TRUE ~ 0),
         `Less than a year` = case_when(N == "Less than a year" ~ 1, 
                                 TRUE ~ 0),
         `1-2 years` = case_when(N == "1-2 years" ~ 1, 
                                 TRUE ~ 0),
         `3-4 years` = case_when(N == "3-4 years" ~ 1, 
                                 TRUE ~ 0),
         `5+ years` = case_when(N == "5+ years" ~ 1, 
                                TRUE ~ 0),
         practice = sub("time_", "", practice)) %>%
  select(!N) %>% 
  group_by(practice) %>% 
  summarise(across(where(is.numeric), ~ sum(.x, na.rm = TRUE)))

# Plot dat setup
implementation_time_plot <- implementation_time %>% 
  pivot_longer(cols = c(`Less than a year`, `1-2 years`, `3-4 years`, `5+ years`),
               names_to = "time",
               values_to = "N") %>% 
  mutate(time = factor(time, levels = c(
    "Less than a year",
    "1-2 years",
    "3-4 years",
    "5+ years"
  )))

# Practice axes setup
cluster_colors <- unique(old_clusters$cluster) %>%
  setNames(object = c(transcend_cols2[c(1, 2, 4, 5)], "#000000"))

clusters <- old_clusters %>% 
  mutate(practice = sub("practices_", "", var)) %>% 
  select(-var)
  
implementation_with_color <- left_join(implementation_time_plot, clusters, by = "practice") %>% 
  mutate(
    color = cluster_colors[cluster],
    practice = fct_inorder(glue("<i style='color:{color}'>{practice}</i>"))
  )

# Plot (referenced Gregor's code)
ggplot(implementation_with_color, aes(reorder(practice, N), N, fill = time)) +
  geom_col() +
  scale_fill_manual(values = transcend_cols) +
  scale_y_continuous(limits=c(0, 85), expand = c(0,0)) +
  labs(title = "Core Practices by Time Implemented",
       x = "",
       y = "") +
  scale_x_discrete(labels = label_tags()) +
  theme(legend.position = "bottom", 
        legend.direction = "horizontal",
        text = element_text(size = 7),
        axis.text.x = element_text(angle = 45, hjust = 1)) + 
  coord_flip() +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom",
    axis.text.y = element_markdown()
  )

time_pilot <- left_join(implementation_time, pilot_prac)

Now let’s sort by pilot practice selection (descending).

# Plot dat setup
implementation_time_plot <- time_pilot %>% 
  pivot_longer(cols = c(`Less than a year`, `1-2 years`, `3-4 years`, `5+ years`),
               names_to = "time",
               values_to = "N") %>% 
  mutate(time = factor(time, levels = c(
    "Less than a year",
    "1-2 years",
    "3-4 years",
    "5+ years"
  )))

implementation_with_color <- left_join(implementation_time_plot, clusters, by = "practice") %>% 
  mutate(
    color = cluster_colors[cluster],
    practice = fct_inorder(glue("<i style='color:{color}'>{practice}</i>"))
  )

ggplot(implementation_with_color, aes(reorder(practice, selected), N, fill = time)) +
  geom_col() +
  scale_fill_manual(values = transcend_cols) +
  scale_y_continuous(limits=c(0, 85), expand = c(0,0)) +
  labs(title = "Core Practices by Time Implemented, From Most to Least Selected to Pilot",
       x = "",
       y = "") +
  scale_x_discrete(labels = label_tags()) +
  theme(legend.position = "bottom", 
        legend.direction = "horizontal",
        text = element_text(size = 7),
        axis.text.x = element_text(angle = 45, hjust = 1)) + 
  coord_flip() +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom",
    axis.text.y = element_markdown()
  )

Update for Aug 2

implementation_with_color %>% 
  group_by(cluster, time) %>% 
  summarise(total = sum(N))
## # A tibble: 20 × 3
## # Groups:   cluster [5]
##    cluster         time             total
##    <chr>           <fct>            <dbl>
##  1 Deeper learning Less than a year     7
##  2 Deeper learning 1-2 years           28
##  3 Deeper learning 3-4 years           50
##  4 Deeper learning 5+ years           199
##  5 Ed justice      Less than a year     6
##  6 Ed justice      1-2 years           40
##  7 Ed justice      3-4 years           48
##  8 Ed justice      5+ years           161
##  9 Individualized  Less than a year     2
## 10 Individualized  1-2 years            9
## 11 Individualized  3-4 years           19
## 12 Individualized  5+ years            59
## 13 None            Less than a year     6
## 14 None            1-2 years           21
## 15 None            3-4 years           49
## 16 None            5+ years           111
## 17 Postsecondary   Less than a year     2
## 18 Postsecondary   1-2 years           17
## 19 Postsecondary   3-4 years           18
## 20 Postsecondary   5+ years            76

Note, cluster counts are different. What is the best way to represent these cluster selections by time given these differences?

implementation_with_color %>% 
  group_by(cluster) %>% 
  summarise(count = n_distinct(practice))
## # A tibble: 5 × 2
##   cluster         count
##   <chr>           <int>
## 1 Deeper learning    12
## 2 Ed justice         19
## 3 Individualized      9
## 4 None               24
## 5 Postsecondary       9
core_prac %>% 
  filter(times_selected >0) %>% 
  mutate(core_practice = gsub("core_", "practices_", core_practice)) %>% 
  left_join(., clean_labels, by = c("core_practice" = "variable")) %>% 
  left_join(., old_clusters, by = c("core_practice" = "var")) %>% 
  group_by(cluster, year) %>% 
  summarise(n = n()) %>% 
  filter(!is.na(cluster)) %>% 
  ggplot(aes(fill = cluster)) +
  geom_col(aes(year, n)) +
  facet_grid(~cluster) +
  scale_y_continuous(expand = c(0,0)) +
  theme(panel.grid.major.x = element_blank(),
        legend.position = "none",
        axis.text.x = element_text(angle = 45, hjust = 1, size = 7)) +
  scale_fill_manual(values = transcend_cols2) +
  labs(title = "Cluster Selection by Year",
       x = "",
       y = "")

implementation_with_color %>% 
  group_by(cluster, time) %>% 
  summarise(total = sum(N)) %>% 
  ggplot(aes(reorder(cluster, total), total, fill = time)) +
  geom_col() +
  scale_fill_manual(values = transcend_cols) +
  scale_y_continuous(expand = c(0,0)) +
  labs(title = "Practice Clusters by Time Implemented",
       x = "",
       y = "") +
  theme(legend.position = "bottom", 
        legend.direction = "horizontal",
        text = element_text(size = 7),
        axis.text.x = element_text(angle = 45, hjust = 1)) + 
  coord_flip() +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom",
    axis.text.y = element_markdown()
  )

implementation_with_color %>% 
  group_by(cluster, time) %>% 
  summarise(total = sum(N)) %>% 
  filter(cluster != "None") %>% 
  ggplot() +
  geom_col(aes(x = reorder(cluster, total), y = total, fill = time)) +
#  geom_text(aes(x = reorder(cluster, total), y = total, label = total), position = "fill") +
  scale_fill_manual(values = transcend_cols) +
  scale_y_continuous(expand = c(0,0)) +
  labs(title = "Practice Clusters by Time Implemented",
       x = "",
       y = "") +
  theme(legend.position = "bottom", 
        legend.direction = "horizontal",
        axis.text.x = element_text(angle = 45, hjust = 1)) + 
  coord_flip() +
  theme(
    panel.grid.major.y = element_blank(),
    legend.position = "bottom",
    legend.title = element_blank(),
    axis.text.y = element_markdown()
  )